Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/keep.zip/MASSDEL.PAS

Pascal/Delphi Source File | 1991-12-19 | 9KB | 375 lines

program massDel;
{-----------------------------------------------------------------------------
 -                                                                           -
 -  MASSDEL.PAS                                                              -
 -                                                                           -
 -    Author: Rick Owen                                                      -
 -    Date  : 12/17/91                                                       -
 -    Massdel:                                                               -
 -     1) parses the command line for file names (or file specs)             -
 -     2) deletes all files which match the specification(s)                 -
 -  These programs carry no warranties either expressed or implied.  I       -
 -  assume no liability of any kind [use at YOUR risk].  Any program         -
 -  which deletes files is inherently dangerous and you should be            -
 -  extremely careful when using either KEEP or MASSDEL.  You are free to    -
 -  use both programs however you wish, and you may freely distribute        -
 -  copies of either program, as long as you do not charge for it [connect   -
 -  charges to BBSes are excluded from this restriction].                    -
 -----------------------------------------------------------------------------}

uses dos, crt;

const

  MAXPARMS  = 50;
  ReadOnly  = $01;
  Hidden    = $02;
  SysFile   = $04;
  VolumeID  = $08;
  Directory = $10;
  Archive   = $20;

  DEBUG     = false;

type
  parmList  = array[1..MAXPARMS] of String[12];

var
  fileParms   : parmList;
  confirm     : boolean;
  silent      : boolean;
  fileCount   : word;
  parmCount   : word;

procedure help;

begin { help }

  writeln('massDel v1.0 - delete all files specified.');
  writeln('usage: massDel [-d] [-s] filespec1 [filespec2 ... filespecN]');
  writeln('   -d = dangerous mode (no confirm)');
  writeln('   -s = silent mode (no report as files are deleted)');
  writeln('        defaults : confirm and not silent');
  writeln;
  writeln('massDel was written in Turbo Pascal V6.0 by Rick Owen');
  writeln('Revision level = 0, Release date = 12/18/91.');
  halt(1);

end { help };

procedure miniHelp;

begin { miniHelp }

  writeln;
  writeln(' y - yes, delete file');
  writeln(' n - no, do not delete file');
  writeln(' q - no, do not delete file and terminate the program');
  writeln(' c - yes, delete file and continue without further confirmation');
  writeln(' l - list remaining files which will be deleted');
  writeln;

end; {miniHelp }

procedure getParameters;

var
  parmLoop    : Word;
  parm        : string[1];

begin { getParameters }

  if (ParamCount < 0) or (ParamCount > MAXPARMS) then
  begin
    help; { we don't return from help }
  end
  else
  begin

    confirm   := true;
    silent    := false;
    parmCount := 1;

    for parmLoop := 1 to ParamCount do
    begin
      if copy(ParamStr(parmLoop),1,1) = '-' then
      begin
        { this is a parameter }
        parm := copy(ParamStr(parmLoop),2,1);
        if ((parm = 's') or (parm = 'S')) then
          silent := true;
        if ((parm = 'd') or (parm = 'D')) then
          confirm := false;
        if (pos(parm,'sSdD') = 0) then
        begin
          write('Unknown parameter - ignored');
          writeln;
        end
      end
      else
      begin
        fileParms[parmCount] := ParamStr(parmLoop);
        inc(parmCount);
      end
    end; { loop }
    dec(parmCount);
    if parmCount = 0 then
      help;
  end; { for }

end; { getParameters }

function LeadingZero(w : Word) : String;

var
  s : String;

begin { LeadingZero }

  Str(w:0,s);
  if Length(s) = 1 then
    s := '0' + s;
  LeadingZero := s;

end; { LeadingZero }

procedure writeFileData( dta : SearchRec );

var
  dt        : DateTime;

begin { writeFileData }

    write(dta.name:12);
    write(dta.size:8);
    write(' ');
    UnpackTime(dta.time,dt);
    with dt do
    begin
      Write(' ',LeadingZero(day), '/',LeadingZero(month),'/',
            LeadingZero(year));
      Write(' ', LeadingZero(hour),':',
            LeadingZero(min),':', LeadingZero(sec));
      Write(' ');
    end;

end; { writeFileData }

procedure listRemainingFiles(      dta : SearchRec;
                             whichParm : word;
                             fileParms : parmList );

var

  t           : SearchRec;
  lineCount   : word;
  ch          : Char;
  parmLoop    : word;

begin { listRemainingFiles }

  parmLoop := whichParm;
  DosError := 0;

  writeln;
  lineCount := 2;
  writeln('───────────── Start of List ─────────────');

  For parmLoop := whichParm to parmCount do
  begin

    if parmLoop = whichParm then
    begin
      move(dta, t, SizeOf(t));
    end
    else
    begin
      findfirst(fileParms[parmLoop], Archive, t);
    end;


    while DosError = 0 do
    begin

      writeFileData( t );
      writeln;
      inc(lineCount);
      if lineCount > 24 then
      begin
        write('───────── pausing - press a key ─────────');
        ch := readKey;
        if ch = #27 then
        begin
          writeln;
          exit;
        end;
        writeln;
        lineCount := 1;
      end;
      findNext( t );

    end; { while }

  end;

  writeln('────────────── End of List ──────────────');

end; { listRemainingFiles }

procedure writePrompt;
begin { writePrompt }
  Write(' : delete (y/N/q/c/l/?) ');
end; { writePrompt }

procedure deleteTheFiles;

var
  fileLoop    : Word;
  dta         : SearchRec;
  listDta     : SearchRec;
  dt          : DateTime;
  confirmKey  : char;
  doExit      : boolean;
  doStop      : boolean;
  deleteIt    : boolean;
  f           : file;

  debugLoop   : word;

begin { deleteTheFiles }

  fileCount := 1;
  deleteIt := true;
  doExit   := false;
  doStop   := false;

  for fileLoop := 1 to parmCount do
  begin

    if (DEBUG) then
    begin
      writeln('searching for ',fileParms[fileLoop]);
    end;

    findfirst(fileParms[fileLoop], Archive, dta);

    if (DEBUG) then
    begin
      writeln('after FindFirst DosError = ',DosError:3);
    end;

    while DosError = 0 do
    begin


      if confirm then
      begin
        writeFileData( dta );
        writePrompt;

        repeat

          confirmKey := upcase(readkey);

          case confirmKey of
            'Y'     : begin
                        deleteIt := true;
                        doExit   := true
                      end;
            'N',#13 : begin
                        doExit   := true;
                        deleteIt := false;
                      end;
            'Q',#27 : begin
                        doExit := true;
                        doStop := true;
                      end;
            'L'     : begin
                        listRemainingFiles( dta, fileLoop, fileParms );
                        writeFileData( dta );
                        writePrompt;
                      end;
            'C'     : begin
                        doExit   := true;
                        deleteIt := true;
                        confirm  := false
                      end;
            '?'     : begin
                        miniHelp;
                        writeFileData( dta );
                        writePrompt;
                      end;

            else      doExit := false;

          end; { case }

        until doExit;
        writeln;
      end;

      if doStop then
      begin

        halt(5);

      end;

      if deleteIt then
      begin

        Assign(f, dta.name);
        {$I-}
        Reset(f);
        {$I+}
        if IOResult <> 0 then
        begin
          WriteLn('Cannot find ', dta.name);
          halt(6);
        end
        else
        begin
          Close(f);
          if not silent then
            writeln('  deleting ', dta.name);
          Erase(f);

        end;

      end;

      if (DEBUG) then
      begin
        write('searching for next ');
        for debugLoop := 1 to 21 do
        begin
          if (dta.fill[debugLoop] > 31) and (dta.fill[debugLoop] < 127) then
            write(chr(dta.fill[debugLoop]))
          else
            write('~');
        end; { for }
        writeln;
      end;

      findnext(dta);

      if (DEBUG) then
      begin
        writeln('after FindNext DosError = ',DosError:3);
      end;

    end; { while }

  end; { for }

end; { deleteTheFiles }

begin { massDel }

  CheckBreak := false;
  getParameters;
  deleteTheFiles;

end { massDel }.